home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Camelot / Camelot 098 (1990-12)(Swedish User Group of Amiga)(SE)(PD)[WB].zip / Camelot 098 (1990-12)(Swedish User Group of Amiga)(SE)(PD)[WB].adf / XLisp-Stat / Functions / handdraw.lsp < prev    next >
Lisp/Scheme  |  1990-10-11  |  2KB  |  50 lines
  1. ; book pp.311-313
  2.  
  3. (setf handdraw (plot-lines (rseq 0 1 50) (repeat 0 50)))
  4. (send handdraw :y-axis nil)
  5. (send handdraw :add-mouse-mode 'drawing
  6.         :title "Drawing"
  7.         :cursor 'finger
  8.         :click :mouse-drawing)
  9. #|
  10. (defmeth handdraw :mouse-drawing (x y m1 m2)
  11.   (flet ((adjust (x y)
  12.            (let* ((n (send self :num-lines))
  13.                   (reals (send self :canvas-to-real x y))
  14.                   (i (x-index (first reals) n))
  15.                   (y (second reals)))
  16.              (send self :linestart-coordinate 1 i y)
  17.              (send self :redraw-content))))
  18.       (adjust x y)
  19.       (send self :while-button-down #'adjust)))
  20. |#
  21. (defmeth handdraw :mouse-drawing (x y m1 m2)
  22.   (let* ((n (send self :num-lines))
  23.          (reals (send self :canvas-to-real x y))
  24.          (old-i (x-index (first reals) n))
  25.          (old-y (second reals)))
  26.   (flet ((adjust (x y)
  27.            (let* ((reals (send self :canvas-to-real x y))
  28.                   (new-i (x-index (first reals) n))
  29.                   (new-y (second reals))
  30.                   (i (iseq old-i new-i))
  31.                   (yvals (interpolate i old-i new-i old-y new-y)))
  32.              (send self :linestart-coordinate 1 i yvals)
  33.              (send self :redraw-content)
  34.              (setf old-i new-i)
  35.              (setf old-y new-y))))
  36.       (adjust x y)
  37.       (send self :while-button-down #'adjust))))
  38. (defun x-index (x n)
  39.   (max 0 (min (- n 1) (floor (* n x)))))
  40. (defun interpolate (x a b ya yb)
  41.   (let* ((range (if-else (/= a b) (- b a) 1))
  42.          (p (pmax 0 (pmin 1 (abs (/ (- x a) range))))))
  43.     (+ (* p yb) (* (- 1 p) ya))))
  44. (defmeth handdraw :lines ()
  45.   (let ((i (iseq (send self :num-lines))))
  46.     (list (send self :linestart-coordinate 0 i)
  47.           (send self :linestart-coordinate 1 i))))
  48.  
  49. (send handdraw :mouse-mode 'drawing)
  50.